home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / sbin / pam-auth-update < prev    next >
Encoding:
Text File  |  2009-09-04  |  18.6 KB  |  693 lines
  1. #!/usr/bin/perl -w
  2.  
  3. # pam-auth-update: update /etc/pam.d/common-* from /usr/share/pam-configs
  4. #
  5. # Update the /etc/pam.d/common-* files based on the per-package profiles
  6. # provided in /usr/share/pam-configs/ taking into consideration user's
  7. # preferences (as determined via debconf prompting).
  8. #
  9. # Written by Steve Langasek <steve.langasek@canonical.com>
  10. #
  11. # Copyright (C) 2008 Canonical Ltd.
  12. #
  13. # This program is free software; you can redistribute it and/or modify
  14. # it under the terms of version 3 of the GNU General Public License as
  15. # published by the Free Software Foundation.
  16. #
  17. # # This program is distributed in the hope that it will be useful,
  18. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. # GNU General Public License for more details.
  21. #
  22. # You should have received a copy of the GNU General Public License
  23. # along with this program; if not, write to the Free Software
  24. # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
  25. # USA.
  26.  
  27. use strict;
  28. use Debconf::Client::ConfModule ':all';
  29. use IPC::Open2 'open2';
  30.  
  31. version('2.0');
  32. my $capb=capb('backup');
  33.  
  34. my $inputdir = '/usr/share/pam-configs';
  35. my $template = 'libpam-runtime/profiles';
  36. my $errtemplate = 'libpam-runtime/conflicts';
  37. my $overridetemplate = 'libpam-runtime/override';
  38. my $blanktemplate = 'libpam-runtime/no_profiles_chosen';
  39. my $confdir = '/etc/pam.d';
  40. my $savedir = '/var/lib/pam';
  41. my (%profiles, @sorted, @enabled, @conflicts, %removals);
  42. my $force = 0;
  43. my $priority = 'high';
  44. my %md5sums = (
  45.     'auth' => [
  46.         '8d4fe17e66ba25de16a117035d1396aa',
  47.         '1fd1e8e87cef1c13898410d830229122',
  48.     ],
  49.     'account' => [
  50.         '3c0c362eaf3421848b679d63fd48c3fa',
  51.         '8a29dc79152ce8441aa90a8f8650d076',
  52.     ],
  53.     'password' => [
  54.         '50fce2113dfda83ac8bdd5a6e706caec',
  55.         '4bd7610f2e85f8ddaef79c7db7cb49eb',
  56.         '9ba753d0824276b44bcadfee1f87b6bc',
  57.     ],
  58.     'session' => [
  59.         '240fb92986c885b327cdb21dd641da8c',
  60.         '4a25673e8b36f1805219027d3be02cd2',
  61.     ],
  62.     'session-noninteractive' => [
  63.         'ad2b78ce1498dd637ef36469430b6ac6',
  64.     ],
  65. );
  66.  
  67. opendir(DIR, $inputdir) || die "could not open config directory: $!";
  68. while (my $profile = readdir(DIR)) {
  69.     next if ($profile eq '.' || $profile eq '..');
  70.     %{$profiles{$profile}} = parse_pam_profile($inputdir . '/' . $profile);
  71. }
  72. closedir DIR;
  73.  
  74. # use a '--force' arg to specify that /etc/pam.d should be overwritten; 
  75. # used only on upgrades where the postinst has already determined that the
  76. # checksums match.  Module packages other than libpam-runtime itself must
  77. # NEVER use this option!  Document with big skullses and crossboneses!  It
  78. # needs to be exposed for libpam-runtime because that's the package that
  79. # decides whether we have a pristine config to be converted, and knows
  80. # whether the version being upgraded from is one for which the conversion
  81. # should be done.
  82.  
  83. while ($#ARGV >= 0) {
  84.     my $opt = shift;
  85.     if ($opt eq '--force') {
  86.         $force = 1;
  87.     } elsif ($opt eq '--package') {
  88.         $priority = 'medium';
  89.     } elsif ($opt eq '--remove') {
  90.         while ($#ARGV >= 0) {
  91.             last if ($ARGV[0] =~ /^--/);
  92.             $removals{shift @ARGV} = 1;
  93.         }
  94.         # --remove implies --package
  95.         $priority = 'medium' if (keys(%removals));
  96.     }
  97. }
  98.  
  99. x_loadtemplatefile('/var/lib/dpkg/info/libpam-runtime.templates','libpam-runtime');
  100.  
  101. # always sort by priority, so we have consistency and don't have to
  102. # shuffle later
  103. @sorted = sort { $profiles{$b}->{'Priority'} <=> $profiles{$a}->{'Priority'}
  104.                  || $b cmp $a }
  105.                keys(%profiles);
  106. # If we're being called for package removal, filter out those options here
  107. @sorted = grep { !$removals{$_} } @sorted;
  108.  
  109. subst($template, 'profile_names', join(', ',@sorted));
  110. subst($template, 'profiles',
  111.     join(', ', map { $profiles{$_}->{'Name'} } @sorted));
  112.  
  113. my $diff = diff_profiles($confdir,$savedir);
  114.  
  115. if ($diff) {
  116.     @enabled = grep { !$removals{$_} } @{$diff->{'mods'}};
  117. } else {
  118.     @enabled = split(/, /,get($template));
  119. }
  120.  
  121. # find out what we've seen, so we can ignore those defaults
  122. my %seen;
  123. if (-e $savedir . '/seen') {
  124.     open(SEEN,$savedir . '/seen');
  125.     while (<SEEN>) {
  126.         chomp;
  127.         $seen{$_} = 1;
  128.     }
  129.     close(SEEN);
  130. }
  131.  
  132. # filter out any options that are no longer available for any reason
  133. @enabled = grep { $profiles{$_} } @enabled;
  134.  
  135. # an empty module set is an error, so in that case grab all the defaults
  136. if (!@enabled) {
  137.     %seen = ();
  138.     $priority = 'high' unless ($force);
  139. }
  140.  
  141. # add any previously-unseen configs
  142. push(@enabled,
  143.      grep { $profiles{$_}->{'Default'} eq 'yes' && !$seen{$_} } @sorted);
  144. @enabled = sort { $profiles{$b}->{'Priority'} <=> $profiles{$a}->{'Priority'}
  145.                   || $b cmp $a }
  146.                 @enabled;
  147. my $prev = '';
  148. @enabled = grep { $_ ne $prev && (($prev) = $_) } @enabled;
  149.  
  150.  
  151. fset($template,'seen','false');
  152. set($template,join(', ', @enabled));
  153.  
  154. # if diff_profiles() fails, and we weren't passed a 'force' argument
  155. # (because this isn't an upgrade from an old version, or the checksum
  156. # didn't match, or we're being called by some other module package), prompt
  157. # the user whether to override.  If the user declines (the default), we
  158. # never again manage this config unless manually called with '--force'.
  159. if (!$diff && !$force) {
  160.     input('high',$overridetemplate);
  161.     go();
  162.     $force = 1 if (get($overridetemplate) eq 'true');
  163. }
  164.  
  165. if (!$diff && !$force) {
  166.     print STDERR <<EOF;
  167.  
  168. pam-auth-update: Local modifications to /etc/pam.d/common-*, not updating.
  169. pam-auth-update: Run pam-auth-update --force to override.
  170.  
  171. EOF
  172.     exit;
  173. }
  174.  
  175. umask(0022);
  176.  
  177. do {
  178.     @conflicts = ();
  179.     input($priority,$template);
  180.     go();
  181.  
  182.     @enabled = split(/, /, get($template));
  183.  
  184.     # in case of conflicts, automatically unset the lower priority
  185.     # item of each pair
  186.     foreach my $elem (@enabled)
  187.     {
  188.         for (my $i=$#enabled; $i >= 0; $i--)
  189.         {
  190.             my $conflict = $enabled[$i];
  191.             if ($profiles{$elem}->{'Conflicts'}->{$conflict}) {
  192.                 splice(@enabled,$i,1);
  193.                 my $desc = $profiles{$elem}->{'Name'}
  194.                     . ', ' . $profiles{$conflict}->{'Name'};
  195.                 push(@conflicts,$desc);
  196.             }
  197.         }
  198.     }
  199.     if (@conflicts) {
  200.         subst($errtemplate, 'conflicts', join("\n", @conflicts));
  201.         input('high',$errtemplate);
  202.     }
  203.     fset($template,'seen','false');
  204.     set($template, join(', ', @enabled));
  205.     if (!@enabled) {
  206.         input('high',$blanktemplate);
  207.     }
  208. } while (@conflicts || !@enabled);
  209.  
  210. # the decision has been made about what configs to use, so even if
  211. # something fails after this, we shouldn't go munging the default
  212. # options again.  Save the list of known configs to /var/lib/pam.
  213. open(SEEN,"> $savedir/seen");
  214. for my $i (@sorted) {
  215.     print SEEN "$i\n";
  216. }
  217. close(SEEN);
  218.  
  219. # @enabled now contains our list of profiles to use for piecing together
  220. # a config
  221. # we have:
  222. # - templates into which we insert the specialness
  223. # - magic comments denoting the beginning and end of our managed block;
  224. #   looking at only the functional config lines would potentially let us
  225. #   handle more cases, at the expense of much greater complexity, so
  226. #   pass on this at least for the first round
  227. # - a representation of the autogenerated config stored in /var/lib/pam,
  228. #   that we can diff against in order to account for changed options or
  229. #   manually dropped modules
  230. # - a hash describing the local modifications the user has made to the
  231. #   config; these are always preserved unless manually overridden with
  232. #   the --force option
  233.  
  234. write_profiles(\%profiles, \@enabled, $confdir, $savedir, $diff, $force);
  235.  
  236.  
  237. # take a single line from a stock config, and merge it with the
  238. # information about local admin edits
  239. sub merge_one_line
  240. {
  241.     my ($line,$diff,$count) = @_;
  242.     my (@opts,$modline);
  243.  
  244.     my ($adds,$removes);
  245.  
  246.     $line =~ /^((\[[^]]+\]|\w+)\s+\S+)\s*(.*)/;
  247.  
  248.     @opts = split(/\s+/,$3);
  249.     $modline = $1;
  250.     $modline =~ s/end/$count/g;
  251.     if ($diff) {
  252.         my $mod = $modline;
  253.         $mod =~ s/[0-9]+//g;
  254.         $adds = \%{$diff->{'add'}{$mod}};
  255.         $removes = \%{$diff->{'remove'}{$mod}};
  256.     } else {
  257.         $adds = $removes = undef;
  258.     }
  259.  
  260.     for (my $i = 0; $i <= $#opts; $i++) {
  261.         if ($adds->{$opts[$i]}) {
  262.             delete $adds->{$opts[$i]};
  263.         }
  264.         if ($removes->{$opts[$i]}) {
  265.             splice(@opts,$i,1);
  266.             $i--;
  267.         }
  268.     }
  269.     return $modline . " " . join(' ',@opts,keys(%{$adds})) . "\n";
  270. }
  271.  
  272. # return the lines for a given config name, type, and position in the stack
  273. sub lines_for_module_and_type
  274. {
  275.     my ($profiles, $mod, $type, $modpos) = @_;
  276.     if ($modpos == 0 && $profiles->{$mod}{$type . '-Initial'}) {
  277.         return $profiles->{$mod}{$type . '-Initial'};
  278.     }
  279.     return $profiles->{$mod}{$type};
  280. }
  281.  
  282. # create a single PAM config from the indicated template and selections,
  283. # writing to a new file
  284. sub create_from_template
  285. {
  286.     my($template,$dest,$profiles,$enabled,$diff,$type) = @_;
  287.     my $state = 0;
  288.     my $uctype = ucfirst($type);
  289.     $type =~ s/-noninteractive//;
  290.  
  291.     open(INPUT,$template) || return 0;
  292.     open(OUTPUT,">$dest") || return 0;
  293.  
  294.     while (<INPUT>) {
  295.         if ($state == 1) {
  296.             if (/^# here's the fallback if no module succeeds/) {
  297.                 print OUTPUT;
  298.                 $state++;
  299.             }
  300.             next;
  301.         }
  302.         if ($state == 3) {
  303.             if (/^# end of pam-auth-update config/) {
  304.                 print OUTPUT;
  305.                 $state++;
  306.             }
  307.             next;
  308.         }
  309.  
  310.         print OUTPUT;
  311.  
  312.         my ($pattern,$val);
  313.         if ($state == 0) {
  314.             $pattern = '^# here are the per-package modules \(the "Primary" block\)';
  315.             $val = 'Primary';
  316.         } elsif ($state == 2) {
  317.             $pattern = '^# and here are more per-package modules \(the "Additional" block\)';
  318.             $val = 'Additional';
  319.         } else {
  320.             next;
  321.         }
  322.  
  323.         if (/$pattern/) {
  324.             my $i = 0;
  325.             my $count = 0;
  326.             # first we need to get a count of lines that we're
  327.             # going to output, so we can fix up the jumps correctly
  328.             for my $mod (@{$enabled}) {
  329.                 my $output;
  330.                 next if (!$profiles->{$mod}{$uctype . '-Type'});
  331.                 next if $profiles->{$mod}{$uctype . '-Type'} ne $val;
  332.                 $output = lines_for_module_and_type($profiles, $mod, $uctype, $i++);
  333.                 # bypasses a perl warning about @_, sigh
  334.                 my @tmparr = split("\n+",$output);
  335.                 $count += @tmparr;
  336.             }
  337.  
  338.             # in case anything tries to jump in the 'additional'
  339.             # block, let's try not to jump off the stack...
  340.             $count-- if ($val eq 'Additional');
  341.  
  342.             # no primary block, so output a stock pam_permit line
  343.             # to keep the stack intact
  344.             if ($val eq 'Primary' && $count == 0)
  345.             {
  346.                 print OUTPUT "$type\t[default=1]\t\t\tpam_permit.so\n";
  347.             }
  348.  
  349.             $i = 0;
  350.             for my $mod (@{$enabled}) {
  351.                 my $output;
  352.                 my @output;
  353.                 next if (!$profiles->{$mod}{$uctype . '-Type'});
  354.                 next if $profiles->{$mod}{$uctype . '-Type'} ne $val;
  355.                 $output = lines_for_module_and_type($profiles, $mod, $uctype, $i++);
  356.                 for my $line (split("\n",$output)) {
  357.                     $line = merge_one_line($line,$diff,
  358.                                            $count);
  359.                     print OUTPUT "$type\t$line";
  360.                     $count--;
  361.                 }
  362.             }
  363.             $state++;
  364.         }
  365.     }
  366.     close(INPUT);
  367.     close(OUTPUT);
  368.  
  369.     if ($state < 4) {
  370.         unlink($dest);
  371.         return 0;
  372.     }
  373.     return 1;
  374. }
  375.  
  376. # take a template file, strip out everything between the markers, and
  377. # return the md5sum of the remaining contents.  Used for testing for
  378. # local modifications of the boilerplate.
  379. sub get_template_md5sum
  380. {
  381.     my($template) = @_;
  382.     my $state = 0;
  383.  
  384.     open(INPUT,$template) || return '';
  385.     my($md5sum_fd,$output_fd);
  386.     my $pid = open2($md5sum_fd, $output_fd, 'md5sum');
  387.     return '' if (!$pid);
  388.  
  389.     while (<INPUT>) {
  390.         if ($state == 1) {
  391.             if (/^# here's the fallback if no module succeeds/) {
  392.                 print $output_fd $_;
  393.                 $state++;
  394.             }
  395.             next;
  396.         }
  397.         if ($state == 3) {
  398.             if (/^# end of pam-auth-update config/) {
  399.                 print $output_fd $_;
  400.                 $state++;
  401.             }
  402.             next;
  403.         }
  404.  
  405.         print $output_fd $_;
  406.  
  407.         my ($pattern,$val);
  408.         if ($state == 0) {
  409.             $pattern = '^# here are the per-package modules \(the "Primary" block\)';
  410.         } elsif ($state == 2) {
  411.             $pattern = '^# and here are more per-package modules \(the "Additional" block\)';
  412.         } else {
  413.             next;
  414.         }
  415.  
  416.         if (/$pattern/) {
  417.             $state++;
  418.         }
  419.     }
  420.     close(INPUT);
  421.     close($output_fd);
  422.     my $md5sum = <$md5sum_fd>;
  423.     close($md5sum_fd);
  424.     waitpid $pid, 0;
  425.  
  426.     $md5sum = (split(/\s+/,$md5sum))[0];
  427.     return $md5sum;
  428. }
  429.  
  430. # merge a set of module declarations into a set of new config files,
  431. # using the information returned from diff_profiles().
  432. sub write_profiles
  433. {
  434.     my($profiles,$enabled,$confdir,$savedir,$diff,$force) = @_;
  435.  
  436.     if (! -d $savedir) {
  437.         mkdir($savedir);
  438.     }
  439.         
  440.     # because we can't atomically replace both /var/lib/pam/$foo and
  441.     # /etc/pam.d/common-$foo at the same time, take steps to make this
  442.     # somewhat robust
  443.     for my $type ('auth','account','password','session',
  444.                   'session-noninteractive')
  445.     {
  446.         my $target = $confdir . '/common-' . $type;
  447.         my $template = $target;
  448.         my $dest = $template . '.pam-new';
  449.  
  450.         my $diff = $diff;
  451.         if ($diff) {
  452.             $diff = \%{$diff->{$type}};
  453.         }
  454.  
  455.         # Detect if the template is unmodified, and if so, use
  456.         # the version from /usr/share.  Depends on knowing the
  457.         # md5sums of the originals.
  458.         my $md5sum = get_template_md5sum($template);
  459.         for my $i (@{$md5sums{$type}}) {
  460.             if ($md5sum eq $i) {
  461.                 $template = '/usr/share/pam/common-' . $type;
  462.                 last;
  463.             }
  464.         }
  465.  
  466.         # first, write out the new config
  467.         if (!create_from_template($template,$dest,$profiles,$enabled,
  468.                                   $diff,$type))
  469.         {
  470.             if (!$force) {
  471.                 return 0;
  472.             }
  473.             $template = '/usr/share/pam/common-' . $type;
  474.             if (!create_from_template($template,$dest,$profiles,
  475.                                       $enabled,$diff,$type))
  476.             {
  477.                 return 0;
  478.             }
  479.         }
  480.  
  481.         # then write out the saved config
  482.         if (!open(OUTPUT, "> $savedir/$type.new")) {
  483.             unlink($dest);
  484.             return 0;
  485.         }
  486.         my $i = 0;
  487.         my $uctype = ucfirst($type);
  488.         for my $mod (@{$enabled}) {
  489.             my $output;
  490.             next if (!$profiles->{$mod}{$uctype . '-Type'});
  491.             next if ($profiles->{$mod}{$uctype . '-Type'} eq 'Additional');
  492.  
  493.             $output = lines_for_module_and_type($profiles, $mod, $uctype, $i++);
  494.             if ($output) {
  495.                 print OUTPUT "Module: $mod\n";
  496.                 print OUTPUT $output . "\n";
  497.             }
  498.         }
  499.  
  500.         # no primary block, so output a stock pam_permit line
  501.         if ($i == 0)
  502.         {
  503.             print OUTPUT "Module: null\n";
  504.             print OUTPUT "[default=1]\t\t\tpam_permit.so\n";
  505.         }
  506.  
  507.         $i = 0;
  508.         for my $mod (@{$enabled}) {
  509.             my $output;
  510.             next if (!$profiles->{$mod}{$uctype . '-Type'});
  511.             next if ($profiles->{$mod}{$uctype . '-Type'} eq 'Primary');
  512.  
  513.             $output = lines_for_module_and_type($profiles, $mod, $uctype, $i++);
  514.             if ($output) {
  515.                 print OUTPUT "Module: $mod\n";
  516.                 print OUTPUT $output . "\n";
  517.             }
  518.         }
  519.  
  520.         close(OUTPUT);
  521.  
  522.         # then do the renames, back-to-back
  523.         # we have to use system because File::Copy is in
  524.         # perl-modules, not perl-base
  525.         if (-e "$target" && $force) {
  526.             system('cp','-f',$target,$target . '.pam-old');
  527.         }
  528.         rename($dest,$target);
  529.         rename("$savedir/$type.new","$savedir/$type");
  530.     }
  531.  
  532.     # at the end of a successful write, reset the 'seen' flag and the
  533.     # value of the debconf override question.
  534.     fset($overridetemplate,'seen','false');
  535.     set($overridetemplate,'false');
  536. }
  537.  
  538. # reconcile the current config in /etc/pam.d with the saved ones in
  539. # /var/lib/pam; returns a hash of profile names and the corresponding
  540. # options that should be added/removed relative to the stock config.
  541. # returns false if any of the markers are missing that permit a merge,
  542. # or on any other failure.
  543. sub diff_profiles
  544. {
  545.     my ($sourcedir,$savedir) = @_;
  546.     my (%diff);
  547.  
  548.     @{$diff{'mods'}} = ();
  549.     # Load the saved config from /var/lib/pam, then iterate through all
  550.     # lines in the current config that are in the managed block.
  551.     # If anything fails here, just return immediately since we then
  552.     # have nothing to merge; instead, the caller will decide later
  553.     # whether to force an overwrite.
  554.     for my $type ('auth','account','password','session',
  555.                   'session-noninteractive')
  556.     {
  557.         my (@saved,$modname);
  558.  
  559.         open(SAVED,$savedir . '/' . $type) || return 0;
  560.         while (<SAVED>) {
  561.             if (/^Module: (.*)/) {
  562.                 $modname = $1;
  563.                 next;
  564.             }
  565.             chomp;
  566.             # trim out the destination of any jumps; this saves
  567.             # us from having to re-parse everything just to fix
  568.             # up the jump lengths, when changes to these will
  569.             # already show up as inconsistencies elsewhere
  570.             s/(\[[^0-9]*)[0-9]+(.*\])/$1$2/g;
  571.             s/(\[.*)end(.*\])/$1$2/g;
  572.             my (@temp) = ($modname,$_);
  573.             push(@saved,\@temp);
  574.         }
  575.         close(SAVED);
  576.  
  577.         my $state = 0;
  578.         my (@prev_opts,$curmod);
  579.         my $realtype = $type;
  580.         $realtype =~ s/-noninteractive//;
  581.  
  582.         open(CURRENT,$sourcedir . '/common-' . $type) || return 0;
  583.         while (<CURRENT>) {
  584.             if ($state == 0) {
  585.                 $state = 1
  586.                    if (/^# here are the per-package modules \(the "Primary" block\)/);
  587.                 next;
  588.             }
  589.             if ($state == 1) {
  590.                 s/^$realtype\s+//;
  591.                 if (/^# here's the fallback if no module succeeds/) {
  592.                     $state = 2;
  593.                     next;
  594.                 }
  595.             }
  596.             if ($state == 2) {
  597.                 $state = 3
  598.                    if (/^# and here are more per-package modules \(the "Additional" block\)/);
  599.                 next;
  600.             }
  601.             if ($state == 3) {
  602.                 last if (/^# end of pam-auth-update config/);
  603.                 s/^$realtype\s+//;
  604.             }
  605.  
  606.             my $found = 0;
  607.             my $curopts;
  608.             while (!$found && $#saved >= 0) {
  609.                 my $line;
  610.                 ($modname,$line) = @{$saved[0]};
  611.                 shift(@saved);
  612.                 $line =~ /^((\[[^]]+\]|\w+)\s+\S+)\s*(.*)/;
  613.                 @prev_opts = split(/\s+/,$3);
  614.                 $curmod = $1;
  615.                 # FIXME: the key isn't derived from the config
  616.                 # name, so collisions are possible if more
  617.                 # than one config references the same module
  618.  
  619.                 $_ =~ s/(\[[^0-9]*)[0-9]+(.*\])/$1$2/g;
  620.                 # check if this is a match for the current line
  621.                 if ($_ =~ /^\Q$curmod\E\s*(.*)$/) {
  622.                     $found = 1;
  623.                     $curopts = $1;
  624.                     push(@{$diff{'mods'}},$modname);
  625.                 }
  626.             }
  627.  
  628.             # there's a line in the live config that doesn't
  629.             # correspond to anything from the saved config.
  630.             # treat this as a failure; it's very error-prone
  631.             # to decide what to do with an added line that
  632.             # didn't come from a package.
  633.             return 0 if (!$found);
  634.  
  635.             for my $opt (split(/\s+/,$curopts)) {
  636.                 my $found = 0;
  637.                 for (my $i = 0; $i <= $#prev_opts; $i++) {
  638.                     if ($prev_opts[$i] eq $opt) {
  639.                         $found = 1;
  640.                         splice(@prev_opts,$i,1);
  641.                     }
  642.                 }
  643.                 $diff{$type}{'add'}{$curmod}{$opt} = 1 if (!$found);
  644.             }
  645.             for my $opt (@prev_opts) {
  646.                 $diff{$type}{'remove'}{$curmod}{$opt} = 1;
  647.             }
  648.         }
  649.         close(CURRENT);
  650.  
  651.         # we couldn't parse the config, so the merge fails
  652.         return 0 if ($state < 3);
  653.     }
  654.     return \%diff;
  655. }
  656.  
  657. # simple function to parse a provided config file, in pseudo-RFC822
  658. # format,
  659. sub parse_pam_profile
  660. {
  661.     my ($profile) = $_[0];
  662.     my $fieldname;
  663.     my %profile;
  664.     open(PROFILE, $profile) || die "could not read profile $profile: $!";
  665.     while (<PROFILE>) {
  666.         if (/^(\S+):\s+(.*)$/) {
  667.             $fieldname = $1;
  668.             # compatibility with the first implementation round;
  669.             # "Auth-Final" is now just called "Auth"
  670.             $fieldname =~ s/-Final$//;
  671.             if ($fieldname eq 'Conflicts') {
  672.                 foreach my $elem (split(/, /, $2)) {
  673.                     $profile{'Conflicts'}->{$elem} = 1;
  674.                 }
  675.             } else {
  676.                 $profile{$fieldname} = $2;
  677.             }
  678.         } else {
  679.             chomp;
  680.             s/^\s+//;
  681.             $profile{$fieldname} .= "\n$_";
  682.             $profile{$fieldname} =~ s/^[\n\s]+//;
  683.         }
  684.     }
  685.     close(PROFILE);
  686.     if (!defined($profile{'Session-Interactive-Only'})) {
  687.             $profile{'Session-noninteractive-Type'} = $profile{'Session-Type'};
  688.             $profile{'Session-noninteractive'} = $profile{'Session'};
  689.             $profile{'Session-noninteractive-Initial'} = $profile{'Session-Initial'};
  690.     }
  691.     return %profile;
  692. }
  693.